home *** CD-ROM | disk | FTP | other *** search
/ L' Effet Pommier 3 / L'Effet Pommier - Volume 03.iso / Programmation / Alpha ƒ / Tcl / SystemCode / appleEvents.tcl < prev    next >
Text File  |  1996-01-10  |  7KB  |  232 lines
  1.  
  2. # make alias list to pass to AEBuild
  3. proc makeAlis {name} {
  4.     return "\[alis(╟[coerce TEXT $name -x alis]╚)\]"    
  5. }
  6.  
  7. proc makeFile {name} {
  8.     return "alis(╟[coerce TEXT $name -x alis]╚)"    
  9. }
  10.  
  11. proc makeAlises {args} {
  12.     set str "\["
  13.     set sep ""
  14.     foreach name $args {
  15.         append str "${sep}alis(╟[coerce TEXT $name -x alis]╚)"
  16.         set sep ","
  17.     }
  18.     append str "\]"
  19.     return $str
  20. }
  21.  
  22. # Queued replies are passed through AEPrint and then to this routine.
  23. proc handleReply {rep} {
  24.     global ALPHA lastReply
  25. #    switchTo $ALPHA
  26.     set lastReply $rep
  27. }
  28.  
  29. # Return an object record specifying the desired think project file.
  30. proc fileObject {name} {
  31.     join [concat {obj\{want:type('SFIL'), from:'null'(), form:'name', seld:╥} [file tail $name] {╙\}}] ""
  32. }
  33.  
  34. proc sendOpenEvent {filler appname fname} {
  35.     if {$filler == "noReply"} {
  36.         AEBuild $appname aevt odoc "----" [makeAlis $fname]
  37.     } else {
  38.         AEBuild -r $appname aevt odoc "----" [makeAlis $fname]
  39.     }
  40. }
  41.  
  42.  
  43. # Send open folder event to Finder. Name must end in colon.
  44. proc openFolder {name} {
  45.     if {![regexp ".*:$" $name]} {
  46.         append name ":"
  47.     }
  48.     sendOpenEvent -r Finder $name
  49. }
  50.  
  51. # Called from Alpha when titlebar "title" menu selected (command-mouse).
  52. proc titlebar {name} {
  53.     if {[file isdir $name]} {
  54.         switchTo Finder
  55.         openFolder $name
  56.     }
  57. }
  58.  
  59. # Send multiple open events
  60. proc sendOpenEvents {appname args} {
  61.     AEBuild -r $appname aevt odoc "----" [eval makeAlises $args]
  62. }
  63.  
  64. #================================================================================
  65. # General Apple Event handling routines
  66. #
  67. # (written by Tom Pollard for use in the MacPerl package)
  68. #================================================================================
  69.  
  70. # Quit an application.
  71. proc sendQuitEvent {appname} {
  72.     AEBuild $appname "aevt" "quit" 
  73. }
  74.  
  75. # Close one of an application's windows, designated by number.
  76. proc sendCloseWinNum {appname num} {
  77.     AEBuild $appname "core" "clos" "----" [AEWinByPos $num]
  78. }
  79.  
  80. # Close one of an application's windows, designated by name.
  81. proc sendCloseWinName {appname name} {
  82.     AEBuild $appname "core" "clos" "----" [AEWinByName $name]
  83. }
  84.  
  85. # Obtain the number of lines in one of an application's
  86. # windows, designated by name.
  87. proc sendCountLines {appname name} {
  88.     set winObj [AEWinByName $name]
  89.     set res [AEBuild -r $appname "core" "cnte" "----" $winObj kocl type('clin')]    
  90.     if {[regexp {:(.*)\}} $res allofit nlines]} {
  91.         return $nlines
  92.     } else {
  93.         return 0
  94.     }
  95. }
  96.  
  97. # Get a selected range of lines from one of an application's
  98. # windows, designated by name.  If $last is missing, then a single
  99. # line is returned; if both $first and $last are missing, then
  100. # the complete window contents are returned.
  101. proc sendGetText {appname name {first {missing}} {last {missing}}} {
  102.     global ALPHA
  103.     set winObj [AEWinByName $name]
  104.     if {$first != "missing"} {
  105.         if {$last != "missing"} {
  106.             set rangDesc [AELineRange $first $last]
  107.         } else {
  108.             set rangDesc [AEAbsPos $first]
  109.         }
  110.         set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
  111.     } else {
  112.         set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
  113.     }
  114.     set res [AEBuild -r $appname "core" "getd" "----" $objDesc]    
  115.     if {![regexp {╥.*╙} $res text]} { set text {} }
  116.     return [string trim $text {╥╙}]
  117. }
  118.  
  119. # Set a selected range of lines in one of an application's
  120. # windows, designated by name.  If $last is missing, then a single
  121. # line is changed; if both $first and $last are missing, then
  122. # the complete window contents are replaced by the new text.
  123. proc sendSetText {appname name text {first {missing}} {last {missing}}} {
  124.     set winObj [AEWinByName $name]
  125.     if {$first != "missing"} {
  126.         if {$last != "missing"} {
  127.             set rangDesc [AELineRange $first $last]
  128.         } else {
  129.             set rangDesc [AEAbsPos $first]
  130.         }
  131.         set objDesc "obj{want:type('clin'), from:$winObj, $rangDesc }"
  132.     } else {
  133.         set objDesc "obj{want:type('ctxt'), from:$winObj, form:'indx', seld:abso('all') }"
  134.     }
  135.     set res [AEBuild -r $appname "core" "setd" "----" $objDesc "data" [curlyq $text]]    
  136.     if {![regexp {╥.*╙} $res text]} { set text {} }
  137.     return [string trim $text {╥╙}]
  138. }
  139.  
  140. ################################################################################
  141. # Utility functions for constructing AppleEvent descriptors for AEBuild
  142. ################################################################################
  143.  
  144. proc AEFilename {name} {
  145.     return "obj{want:type('file'), from:'null'(), [AEName $name] } "
  146. }
  147.  
  148. proc AEWinByName {name} {
  149.     return "obj{want:type('cwin'), from:'null'(), [AEName $name] } "
  150. }
  151.  
  152. proc AEWinByPos {absPos} {
  153.     return "obj{want:type('cwin'), from:'null'(), [AEAbsPos $absPos] } "
  154. }
  155.  
  156. proc AELineRange {absPos1 absPos2} {
  157.     set lineObj1 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos1] }"
  158.     set lineObj2 "obj{ want:type('clin'), from:'ccnt'(), [AEAbsPos $absPos2] }"
  159.     return "form:'rang', seld:rang{star:$lineObj1, stop:$lineObj2 } "
  160. }
  161.  
  162. proc AEAbsPos {posName} {
  163. #
  164. # Use '1' or 'first' to specify first position
  165. # and '-1' or 'last' to specify last position.
  166. #
  167.     if {$posName == "first"} { 
  168.         set posName 1 
  169.     } elseif {$posName == "last"} { 
  170.         set posName -1 
  171.     }
  172.     if {$posName >= -1} {
  173.         return "form:indx, seld:long($posName)"
  174.     } else {
  175.         error "AEAbsPos: bad argument"
  176.     }
  177. }
  178.  
  179. proc AEName {name} {
  180.     return "form:'name', seld:[curlyq $name]"
  181. }
  182.  
  183. proc curlyq {str} {
  184.     return "\╥$str\╙"
  185. }
  186.  
  187. ################################################################################
  188. proc nullObject {}                     { return "'null'()" }
  189. proc objectType {type}                 { return "type($type)" }
  190. proc nameObject {type name from}     { return "obj \{form:name, want:[objectType $type], seld:$name, from:$from\}" }
  191. proc indexObject {type ind from}     { return "obj \{form:indx, want:[objectType $type], seld:$ind, from:$from\}" }
  192. proc propertyObject { prop object } { return "obj \{form:prop, want:[objectType prop], seld:[objectType $prop], from:$object\}" }
  193.  
  194. # 'process' must have single quotes
  195. proc buildMsgReply { process suite event args } { return [eval [list AEBuild -r $process $suite $event ] $args] }
  196.  
  197. proc countObjects { process fromObject class } {
  198.     set res [AEBuild -r $process core cnte ---- $fromObject kocl [objectType $class]]
  199.     if {[regexp {:([0-9]+)} $res dummy mtch]} {
  200.         return $mtch
  201.     } else {
  202.         error "Bad count proc"
  203.     }
  204. }
  205.  
  206. proc createThingAtEnd {process container class} {
  207.     set res [AEBuild -r $process core crel insh "insl \{kobj:$container\}" kocl "type($class)"]
  208. }
  209.  
  210.  
  211. proc getObjectData { process class name from } {
  212.     set res [AEBuild -r $process core getd ---- [nameObject $class "╥$name╙" $from] {rtyp{type:TEXT}}]
  213.     if {[regexp {╥(.*)╙} $res dummy mtch]} {
  214.         return $mtch
  215.     } else {
  216.         error "Bad count proc"
  217.     }
  218. }
  219.  
  220.  
  221. proc objectProperty { process property object } {
  222.     AEBuild -r $process core getd ---- [propertyObject $property $object]
  223. }
  224.  
  225. # Extract and return a path from a result.
  226. proc extractPath {res} {
  227.     if {[regexp {╟(.*)╚} $res dummy fss]} {
  228.         return [specToPathName $fss]
  229.     }
  230.     error "bad path $name"
  231. }    
  232.